home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1997 February
/
EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso
/
enigma
/
earcd
/
editor
/
editor2
/
fntct103.lha
/
FontCatalog103.rexx
< prev
Wrap
OS/2 REXX Batch file
|
1996-11-03
|
18KB
|
622 lines
/*---------------------------------------*/
/* $VER: FontCatalog V1.03 (03 Nov 1996) */
/* ©1996 Michael Merkel */
/*---------------------------------------*/
/*
how to use this:
----------------
* copy this into your PageStream3:Scripts/ drawer
* select "Play Script" in PageStream3 and start FontCatalog
* if you want to use fixed fontsize you must
1. activate the "use fixed fontsize" checkbox
2. specify the fontsize in the horizontal # field!! <- don't forget this!
* specify the offsets and the sample text
(you can use "*n" for a newline character. e.g. "aA*nbB" will print:
aA
bB
and "*t" for a tabulator)
*/
OPTIONS RESULTS
/* Make sure rexx support is opened */
IF ~SHOW('L','rexxsupport.library') THEN
CALL ADDLIB('rexxsupport.library',0,-30)
IF ~SHOW('L','softlogik:libs/slarexxsupport.library') THEN
CALL ADDLIB('softlogik:libs/slarexxsupport.library',0,-30)
ADDRESS 'PAGESTREAM'
/* defaults */
fcversion = 'V1.03'
measure = 'pt'
tf.0 = 'FALSE'
tf.1 = 'TRUE'
'GETPAGEMASTERPAGE MASTERPAGE mname'
if (RC = 10) then CALL DOERRORREQUESTER
defmeasure = GetDefaultMeasurementSystem()
'GETDIMENSIONS dim MASTERPAGE "'mname'"'
if (dim.orientation = 'PORTRAIT')
then do
rpagesizex = dim.width
rpagesizey = dim.height
end
else do
rpagesizex = dim.height
rpagesizey = dim.width
end
CALL ReadPrefs
/* get and count available fonts */
'GETFONTLIST fonts'
fontnum = RESULT
/* get user choices */
CALL DOREQUESTER
if (ergebnis = cancelhandler)
then do
''defmeasure''
EXIT
end
CALL WritePrefs
/* some more defaults and transformations */
pagenumber = 1
maxheight = 0
if (ffs = 1) then ffs_size = p2d(numx,measure)
else ffs_size = 30
pagesizex = rpagesizex
pagesizey = rpagesizey
leftgap = p2d(WORD(rgapsnsize,1),measure)
rightgap = p2d(WORD(rgapsnsize,2),measure)
topgap = p2d(WORD(rgapsnsize,3),measure)
bottomgap = p2d(WORD(rgapsnsize,4),measure)
gap = p2d(WORD(rgapsnsize,5),measure)
txtsize = p2d(WORD(rgapsnsize,6),measure)
startx = leftgap
starty = topgap
if (ffs = 0)
then do
/* horizontal and vertical sizes for one sample */
psx = (pagesizex-leftgap-rightgap-(numx-1)*gap) / numx
psy = (pagesizey-topgap-bottomgap-(numy-1)*gap-numy*txtsize) / numy
/* horizontalsize/verticalsize */
psf = psx / psy
/* number of samples/page */
anzp = numx * numy
end
num = 0
/* draw border for first page */
CALL DrawPageBorder
BusyReq = OpenBusyMessage('getting pictures ...')
'REFRESH OFF'
CALL DoAllFonts
CALL CLEANUP
EXIT
DoAllFonts:
/* current number of pics per page */
nppp = 0
do num = 0 to fontnum-1
lastpic = 0
CALL AddObject(fonts.num)
if (lastpic = 1)
then do /* letztes Bild auf Seite bearbeitet */
Call SetBusyMessage(BusyReq,'refreshing display...')
'REFRESH ON'
'REFRESHWINDOW'
if (print = 1) then CALL PrintPage
else 'DISPLAY PAGE NEXT'
pagenumber = pagenumber + 1
nppp = 0
CALL DrawPageBorder
'REFRESH OFF'
end
end
if ((nppp > 0) & (print = 1))
then do /* ready but not printed yet */
Call SetBusyMessage(BusyReq,'refreshing display...')
'REFRESH ON'
'REFRESHWINDOW'
CALL PrintPage
end
RETURN
AddObject:
ARG name
CALL getbusy(name||' (#'||num||')')
d1 = startx
d2 = starty
call DrawTextObject
pwidth = posi.right - posi.left
pheight = posi.bottom - posi.top
if (pheight>maxheight) then maxheight = pheight
/* textframe anpassen -> no fixed fontsize! */
if (ffs=0)
then do
gsf = pwidth / pheight
if (gsf > psf) then factor = psx / pwidth
else factor = psy / pheight
newpwidth = factor * pwidth - 2 /* 1 point less on each side (for nonborder overlapping) */
newpheight = factor * pheight - 2
centerdeltax = (psx - newpwidth) / 2
centerdeltay = (psy - newpheight) / 2
d3 = d1 + psx
d4 = d2 + psy
if ((d3 - 1) > (pagesizex - rightgap)) /* well, it's too far right! */
then do
startx = leftgap
starty = d4 + gap + txtsize
d1 = startx
d2 = starty
d3 = d1 + psx
d4 = d2 + psy
end
if ((d4 + txtsize - 1) > (pagesizey - bottomgap)) /* now it's too far down! */
then do
startx = leftgap
starty = topgap
lastpic = 1 /* last picture already placed! print or flip page and go on... */
num = num - 1
'DELETEOBJECT OBJECTID 'txtid
RETURN
end
startx = d3 + gap
newl = d1 + centerdeltax
newt = d2 + centerdeltay
newr = newl + newpwidth
newb = newt + newpheight
'EDITTEXTOBJ POSITION 'newl newt newr newb' OBJECTID 'txtid
end
/* textframes berechnen -> fixed fontsize! */
else do
d3 = d1 + pwidth + 6
d4 = d2 + pheight + 6
if ((d3 - 1) > (pagesizex - rightgap)) /* it's too far right! */
then do
startx = leftgap
starty = d2 + maxheight + 6 + gap + txtsize
d1 = startx
d2 = starty
d3 = d1 + pwidth + 6
d4 = d2 + pheight + 6
if ((d3 - 1) > (pagesizex - rightgap)) then call ErrorExit
maxheight = 0
end
if ((d4 + txtsize - 1) > (pagesizey - bottomgap))
then do
startx = leftgap
starty = topgap
if ((starty + pheight + 6 + txtsize - 1) > (pagesizey - bottomgap)) then call ErrorExit
num = num - 1
mayheight = 0
lastpic = 1
'DELETEOBJECT OBJECTID 'txtid
RETURN
end
startx = d3 + gap
newl = d1 + 3
newt = d2 + 3
newr = d3 - 3
newb = d4 - 3
'EDITTEXTOBJ POSITION 'newl newt newr newb' OBJECTID 'txtid
end
if (txtsize > 0) then do
'DRAWTEXTOBJ 'd1 d4' INFRONT'
txtid = RESULT
'SELECTTEXT AT 'd1 d4' FRONTMOST'
'BEGINCOMMANDCAPTURE'
'SETTRACKTABLE NONE'
'SETLEADING RELATIVE 100%'
'SETTYPESIZE 'txtsize
'SETPARAGRAPHSTYLE "FontName"'
'ENDCOMMANDCAPTURE'
'INSERT "'name'"'
'GETTEXTOBJ POSITION txtpos OBJECTID 'txtid
txtp2.left = txtpos.left
txtp2.top = txtpos.top
txtp2.bottom = txtpos.bottom
txtp2.right = txtpos.right
txtwidth = txtp2.right - txtp2.left
if (txtwidth > (d3-d1)) then 'EDITTEXTOBJ POSITION 'txtp2.left' 'txtp2.top' 'd3' 'txtp2.bottom' OBJECTID 'txtid
end
'DRAWBOX 'd1 d2 d3 d4
'SETSTROKEWEIGHT 1pt'
nppp = nppp + 1
RETURN
DrawTextObject:
'DRAWTEXTOBJ 'd1 d2' INFRONT'
tid = RESULT
'SELECTTEXT AT 'd1 d2' FRONTMOST'
if (num > 0) then 'PASTETEXT' /* puffer ausgeben */
else do /* nur _einmal_ text generieren */
do fsk = 1 to LENGTH(fsample)
ifsample = SUBSTR(fsample,fsk,1)
if ifsample = '*'
then do
fsk = fsk+1
i2fsample = SUBSTR(fsample,fsk,1)
SELECT
WHEN i2fsample = 'n' THEN 'INSERTCONTROL NEWLINE'
WHEN i2fsample = 't' THEN 'INSERTCONTROL TAB'
WHEN i2fsample = '*' THEN 'INSERT "*"'
OTHERWISE 'INSERT "*'ifsample'"'
end
end
else 'INSERT "'ifsample'"'
end
'SELECTTEXT ALL'
'BEGINCOMMANDCAPTURE'
'SETTRACKTABLE NONE'
'SETLEADING RELATIVE 100%'
'SETTYPESIZE 'ffs_size
'ENDCOMMANDCAPTURE'
if (num=0) then 'COPYTEXT'
end
'SETFONT "'name'"'
'GETTEXTOBJ POSITION posi OBJECTID 'tid
txtid = RESULT
RETURN
DrawPageBorder:
d1 = leftgap - 5
d2 = topgap - 5
d3 = pagesizex-rightgap + 5
d4 = pagesizey-bottomgap + 5
'DRAWBOX 'd1 d2 d3 d4
'SETSTROKEWEIGHT 3pt'
d4 = d4 + 2
'DRAWTEXTOBJ 'd1 d4' INFRONT'
txtid = RESULT
'SELECTTEXT AT 'd1 d4' FRONTMOST'
bottomtxtsize = 12
bottomtwidth = d3 - d1
'BEGINCOMMANDCAPTURE'
'SETTRACKTABLE NONE'
'SETLEADING RELATIVE 100%'
'SETTYPESIZE "'bottomtxtsize'"'
'ENDCOMMANDCAPTURE'
'INSERT "FontCatalog '||fcversion||' - ©1996 Michael Merkel"'
'SETTABRULER "RIGHT" 'bottomtwidth
'INSERTCONTROL TAB'
'INSERT "Page 'pagenumber'"'
RETURN
PrintPage:
output.0 = 'GRAYSCALE'
output.1 = 'COLOR'
Call SetBusyMessage(BusyReq,'printing page...')
if (prscale = 0) then do
'PRINTDOCUMENT PAGE "" OUTPUT 'output.prmethod' SCALE "ACTUAL"'
end
if (prscale = 1) then do
'PRINTDOCUMENT PAGE "" OUTPUT 'output.prmethod' SCALE "FULLPAGE"'
end
'SELECTOBJECT ALL'
'DELETEOBJECT'
RETURN
DOREQUESTER:
filehandler = 0
ergebnis = filehandler
do until ((ergebnis = okhandler) | (ergebnis = cancelhandler))
'ALLOCAREXXREQUESTER "FontCatalog '||fcversion||' - ©1996 Michael Merkel" 350 280'
reqhandle = RESULT
'ADDAREXXGADGET 'reqhandle' EXIT 10 260 70 LABEL "_Make"'
okhandler = RESULT
'ADDAREXXGADGET 'reqhandle' EXIT 270 260 70 LABEL "_Cancel"'
cancelhandler = RESULT
'ADDAREXXGADGET 'reqhandle' EXIT 115 260 120 LABEL "_Print Settings"'
pprefshandler = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 250 5 55 STRING "'numx'" LABEL "# of font samples horizontal:"'
numx_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 250 20 55 STRING "'numy'" LABEL "# of font samples vertical: "'
numy_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' CHECKBOX 10 35 250 CHECKED "'tf.ffs'" LABEL "use fixed fontsize (# horizontal!)"'
ffs_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' TEXT 10 55 200 STRING "(hint: 'fontnum' fonts found!)"'
'ADDAREXXGADGET 'reqhandle' TEXT 10 80 112 STRING "page offsets:"'
'ADDAREXXGADGET 'reqhandle' STRING 63 100 70 STRING "'WORD(rgapsnsize,1)'" LABEL "left:"'
rleftgap_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 63 115 70 STRING "'WORD(rgapsnsize,2)'" LABEL "right:"'
rrightgap_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 200 100 70 STRING "'WORD(rgapsnsize,3)'" LABEL "top:"'
rtopgap_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 200 115 70 STRING "'WORD(rgapsnsize,4)'" LABEL "bottom:"'
rbottomgap_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 175 140 50 STRING "'WORD(rgapsnsize,5)'" LABEL "gap between samples:"'
rgap_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 175 160 50 STRING "'WORD(rgapsnsize,6)'" LABEL "namesize (0 = none):"'
rtxtsize_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' STRING 10 200 330 STRING "'fsample'" LABEL "specify the sample text:" LABELPOS ABOVELEFT'
fsample_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' CHECKBOX 10 230 10 CHECKED "'tf.print'" LABEL "print every single page"'
print_gadget = RESULT
'ADDAREXXGADGET 'reqhandle' TEXT 30 240 240 STRING "(instead of collecting them)"'
'DOAREXXREQUESTER 'reqhandle
ergebnis = RESULT
'GETAREXXGADGET 'reqhandle' 'numx_gadget' STRING'
numx = RESULT
'GETAREXXGADGET 'reqhandle' 'numy_gadget' STRING'
numy = RESULT
'GETAREXXGADGET 'reqhandle' 'ffs_gadget' CHECKED'
ffs = RESULT
'GETAREXXGADGET 'reqhandle' 'rleftgap_gadget' STRING'
rgapsnsize = SPACE(RESULT,0)
'GETAREXXGADGET 'reqhandle' 'rrightgap_gadget' STRING'
rgapsnsize = rgapsnsize SPACE(RESULT,0)
'GETAREXXGADGET 'reqhandle' 'rtopgap_gadget' STRING'
rgapsnsize = rgapsnsize SPACE(RESULT,0)
'GETAREXXGADGET 'reqhandle' 'rbottomgap_gadget' STRING'
rgapsnsize = rgapsnsize SPACE(RESULT,0)
'GETAREXXGADGET 'reqhandle' 'rgap_gadget' STRING'
rgapsnsize = rgapsnsize SPACE(RESULT,0)
'GETAREXXGADGET 'reqhandle' 'rtxtsize_gadget' STRING'
rgapsnsize = rgapsnsize SPACE(RESULT,0)
'GETAREXXGADGET 'reqhandle' 'fsample_gadget' STRING'
fsample = RESULT
'GETAREXXGADGET 'reqhandle' 'print_gadget' CHECKED'
print = RESULT
'FREEAREXXREQUESTER 'reqhandle
if (ergebnis = pprefshandler) then CALL PrintSettings
end
RETURN
PrintSettings:
'ALLOCAREXXREQUESTER "Please set the settings for printing ..." 230 80'
reqhandle2 = RESULT
'ADDAREXXGADGET 'reqhandle2' EXIT 10 60 70 LABEL "_Ok"'
okhandler2 = RESULT
'ADDAREXXGADGET 'reqhandle2' EXIT 150 60 70 LABEL "_Cancel"'
cancelhandler2 = RESULT
'ALLOCAREXXLIST'
rexxlist2 = RESULT
'ADDAREXXLIST 'rexxlist2' "Grayscale"'
'ADDAREXXLIST 'rexxlist2' "Color"'
'ADDAREXXGADGET 'reqhandle2' CYCLE 75 10 100 LABEL "Method:"'
prmethod_gadget = RESULT
'SETAREXXGADGET 'reqhandle2' 'prmethod_gadget' LIST 'rexxlist2' CURRENT 'prmethod
'ALLOCAREXXLIST'
rexxlist3 = RESULT
'ADDAREXXLIST 'rexxlist3' "Actual Size"'
'ADDAREXXLIST 'rexxlist3' "Scale To Fit"'
'ADDAREXXGADGET 'reqhandle2' CYCLE 75 30 130 LABEL "Scale:"'
prscale_gadget = RESULT
'SETAREXXGADGET 'reqhandle2' 'prscale_gadget' LIST 'rexxlist3' CURRENT 'prscale
'DOAREXXREQUESTER 'reqhandle2
ergebnis2 = RESULT
if (ergebnis2 = okhandler2)
then do
'GETAREXXGADGET 'reqhandle2' 'prmethod_gadget' CURRENT'
prmethod = RESULT
'GETAREXXGADGET 'reqhandle2' 'prscale_gadget' CURRENT'
prscale = RESULT
end
'FREAREXXLIST 'rexxlist2
'FREAREXXLIST 'rexxlist3
'FREEAREXXREQUESTER 'reqhandle2
RETURN
DOERRORREQUESTER:
'ALLOCAREXXREQUESTER "Error!" 300 50'
reqhandle = RESULT
'ADDAREXXGADGET 'reqhandle' EXIT 115 30 70 LABEL "_Ok"'
dummy = RESULT
'ADDAREXXGADGET 'reqhandle' TEXT 10 10 280 STRING "Please open a new document first!"'
'DOAREXXREQUESTER 'reqhandle
dummy = RESULT
'FREEAREXXREQUESTER 'reqhandle
exit
RETURN
ErrorExit:
'ALLOCAREXXREQUESTER "FATAL ERROR!" 330 70'
reqhandle = RESULT
'ADDAREXXGADGET 'reqhandle' EXIT 115 50 70 LABEL "_Ok"'
dummy = RESULT
'ADDAREXXGADGET 'reqhandle' TEXT 10 10 300 STRING "One font is too big!"'
'ADDAREXXGADGET 'reqhandle' TEXT 10 30 300 STRING "Please restart with smaller fontsize!"'
'DOAREXXREQUESTER 'reqhandle
dummy = RESULT
'FREEAREXXREQUESTER 'reqhandle
call CLEANUP
EXIT
SetBusyMessage:
ARG BReq,BMess
'SETBUSYREQUESTER 'BReq' MESSAGE "'BMess'"'
RETURN
OpenBusyMessage:
ARG BMess
BReq = 0
'OPENBUSYREQUESTER MESSAGE "'BMess'" THERMOMETER DISABLED ABORT ENABLED'
BReq=result
RETURN BReq
GETBUSY:
ARG messname
if (length(messname) > 27)
then mess = '...'||right(messname,25)
else mess = messname
Call SetBusyMessage(BusyReq,mess)
'GETBUSYREQUESTER 'BusyReq
if (result=1) then do
if (npp = 0) then do
'SELECTOBJECT ALL'
'DELETEOBJECT'
'DISPLAY PAGE PREVIOUS'
end
CALL CLEANUP
end
RETURN
CLEANUP:
if (BusyReq>0) then 'CLOSEBUSYREQUESTER 'BusyReq
/* reset the measurementsystem to the saved one!! */
''defmeasure''
'REFRESH ON'
'REFRESHWINDOW'
EXIT
ReadPrefs:
ok = Open('Prefs','PageStream3:Scripts/FontCatalog.prefs','R')
if (ok = 1)
then do
dummy = ReadLn('Prefs')
if (right(dummy,4) >= 1.02)
then do
say 'correct version! reading old prefs...'
numx = ReadLN('Prefs')
numy = ReadLN('Prefs')
ffs = ReadLN('Prefs')
rgapsnsize = ReadLN('Prefs')
fsample = ReadLN('Prefs')
print = ReadLN('Prefs')
prscale = ReadLN('Prefs')
pcpread = 1
end
else do
pcpread = 0
say 'old prefsfile detected! -> default values'
fsample = '!OLD PREFSFILE -> USING DEFAULTS!'
end
cl = Close('Prefs')
end
else do
pcpread = 0
say 'no prefsfile! -> default values'
end
if (pcpread = 0)
then do
numx = 6
numy = 8
ffs = 0
rgapsnsize = '2cm 2cm 2cm 2.5cm 1mm 6pt'
fsample = 'aA*nbB'
print = 0
prscale = 0
end
RETURN
WritePrefs:
ok = Open('Prefs','PageStream3:Scripts/FontCatalog.prefs','W')
if (ok = 1) then do
say 'writing prefs...'
WriteLN('Prefs','TCP'||fcversion)
WriteLN('Prefs',numx)
WriteLN('Prefs',numy)
WriteLN('Prefs',ffs)
WriteLN('Prefs',rgapsnsize)
WriteLN('Prefs',fsample)
WriteLN('Prefs',print)
WriteLN('Prefs',prscale)
cl = Close('Prefs')
end
else do
say 'error writing prefs file "FontCatalog.prefs"'
end
RETURN
GetDefaultMeasurementSystem:
PROCEDURE
'GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro'
st = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
'SETMEASUREMENTS COORDINATE POINTS SAMEAS RELATIVE SAMEAS TEXT POINTS FROM PAGE'
RETURN st